home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / PKV4.ZIP;1 / PACKLOOK.PRG < prev    next >
Encoding:
Text File  |  1993-02-05  |  15.5 KB  |  421 lines
  1. /*⁄ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒø
  2.  ›≥                                                                      ≥
  3.  ›≥    Program Name: PACKLOOK.PRG                                        ≥
  4.  ›≥         Purpose: Interface Pkzip files                               ≥
  5.  ›≥        Language: Clipper 5.0                                         ≥
  6.  ›≥ Original Author: Micheal Todd Charron     Oct. 16 1990               ≥
  7.  ›≥     Modified By: Kevin S. Gallagher       Feb. 04 1993               ≥
  8.  ›≥                                                                      ≥
  9.  ›≥ The core routine is to read a PKzip compressed file, and return the  ≥
  10.  ›≥ following information:                                               ≥
  11.  ›≥ file_name  - dos filename of each file in the zipfile                ≥
  12.  ›≥ file_date  - dos date of last modification to "file_name"            ≥
  13.  ›≥ file_size  - uncompressed and compressed bytes of "file_name"        ≥
  14.  ›≥ file_time  - dos time stamp of "file_name"                           ≥
  15.  ›≥ ratio      - precentage 0 - 100% of original file size               ≥
  16.  ›≥ stored     - how PKzip stored "file_name" ie. Deflated, Crunched etc.≥
  17.  ›≥                                                                      ≥
  18.  ›≥ Modifications were made to allow the core to read PKzip v2.nn        ≥
  19.  ›≥ and some simple screen I/O stuff.                                    ≥
  20.  ›¿ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒŸ
  21.  flflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflflfl           */
  22.  
  23. //ƒƒƒƒƒ undefine test to remove the sample interface
  24. #define TEST
  25. //ƒƒƒƒƒ undefine use_help to remove the help function if not needed
  26. #define USE_HELP
  27. //ƒƒƒƒƒ review whats up before undefining KSG directive!
  28. #define KSG
  29.  
  30. #ifdef KSG
  31.    #include "include1.ch"
  32. #else
  33.    #include "fileio.ch"
  34.    #include "inkey.ch"
  35.    #include "box.ch"
  36. #endif
  37.  
  38. STATIC cWhichFile:=""
  39.  
  40. #ifdef TEST
  41.  
  42. STATIC aBar_ :={}, aFiles_ :={}, rel_ele := 0
  43.  
  44. FUNCTION TestMe
  45.     local SaveFullScreen(), oldcolor:= setcolor("w+/b,b/w"), xNum:=0,oldcurs
  46.     local nTr:=10,nTc:=30,nBr:=15,nBc:=49
  47.     aFiles_:= getfiles()
  48.     ZoomBox(nTr-1,nTc-1,nBr+1,nBc+1,"W+/B" , 40, .T. )
  49.     aBar_  := ScrollBarDisplay( { nTr, nBc+1, nBr, nBc+1, "gr+/b", 1 } )
  50.     keyboard chr(255)
  51.     WHILE LASTKEY() <> K_F10
  52.         ACHOICE(nTr,nTc,nBr,nBc,aFiles_,,"ashell",rel_ele)
  53.     ENDDO
  54.     oldcurs :=setcursor( 0 )
  55.     FOR xNum = 0 TO MR
  56.         RESTSCREEN(0,0,xNum,MC,oldscrn)
  57.         inkey(.1)
  58.     NEXT
  59.     setcursor( oldcurs )
  60.     setcolor( oldcolor )
  61.     @1,0
  62.     @0,0 say PADR(" PK-LOOK created by Kevin S. Gallagher",80) color "n/bg"
  63. return nil
  64. FUNCTION ashell( status, curr_ele, nRight)
  65.     local RetVal := 2, nKey := lastkey()
  66.     DO CASE
  67.         CASE status EQ 0 .OR. nKey EQ 255
  68.             ScrollBarUpdate(aBar_,Curr_ele,len(aFiles_),TRUE)
  69.         CASE status EQ 1
  70.             keyboard CHR(K_CTRL_PGDN)
  71.             RetVal  := 2
  72.         CASE status EQ 2
  73.             keyboard CHR(K_CTRL_PGUP)
  74.             RetVal  := 2
  75.         CASE nKey   EQ K_ENTER
  76.             ZIPPER(aFiles_[ curr_ele ])
  77.             RetVal  := 2
  78.         CASE nKey   EQ K_HOME
  79.             keyboard CHR(K_CTRL_PGUP)
  80.         CASE nKey   EQ K_END
  81.             keyboard CHR(K_CTRL_PGDN)
  82.         CASE nKey   EQ K_ESC .OR. nKey EQ K_F1
  83.             alert("TO EXIT PROGRAM;PRESS FUNCTION KEY LABELED F10",{" OKAY "})
  84.             RetVal  := 2
  85.         CASE nKey   EQ K_F10
  86.             RetVal  := 0
  87.         CASE nKey   EQ K_LEFT
  88.             keyboard CHR(K_DOWN)
  89.         CASE nKey   EQ K_RIGHT
  90.             keyboard CHR(K_UP)
  91.         CASE nKey   EQ K_SPACEBAR
  92.             RetVal  := 2
  93.     ENDCASE
  94. return RetVal
  95.  
  96. FUNCTION getfiles
  97.     local GetZips_:= DIRECTORY("*.ZIP"), aArr_:={}
  98.     dispbox(0,0,MR,MC,replicate(chr(176),9),"w+/w")
  99.     if LEN(GetZips_) EQ 0
  100.         ALERT(" NO FILES FOUND TO PROCESS", {" QUIT "})
  101.         QUIT
  102.     endif
  103.     AEVAL( GetZips_,{ | x | AADD(aArr_, x[1]) } )
  104.     aArr_:=ASORT( aArr_ )
  105. return aArr_
  106. #endif
  107.  
  108.  
  109. FUNCTION ZIPPER( cCommandLine )
  110.    local cInfo, aPacked:={}, cDefCol, cFName, nHand, nNoOfRows, xNum:=0
  111.    local oldcur:=setcursor( 0 ), oldcolor:=setcolor("w+/b"), SaveFullScreen()
  112.    local nTestHand:=0,cBuf:=space(5)
  113.  
  114.  
  115.    nTestHand := FOPEN( cCommandLine )
  116.    if FERROR() = 0
  117.        FREAD(nTestHand, @cBuf, 5)
  118.        FCLOSE( nTestHand )
  119.    endif
  120.    /*
  121.    * Modifications to read all files within PKZIP v2.nn
  122.    * -KSG 02/04/93
  123.    */
  124.  
  125.    cInfo :=                                                                 ;
  126.    { 30, 14, 13, 11, 12, 23, 19,                                            ;
  127.    { | cFileInfo      | ( "PK"+ CHR( 3 ) + CHR( 4 ) ) $ cFileInfo },        ;
  128.    { | cFileInfo      | FileType( ASC( SUBS(cFileInfo,9,1) ) )    },        ;
  129.    { | cFileInfo,nHand| cFName := SPACE( ASC( SUBS(cFileInfo,27,1))),       ;
  130.      FREAD(nHand,@cFName,LEN( cFName ) ),cFName }                           ;
  131.    }
  132.  
  133.    nNoOfRows := PackInfo( cCommandLine, aPacked, cInfo)
  134.  
  135.    IF nNoOfRows EQ 0
  136.       alert("CORRUPTION DETECTED IN ZIPFILE",{" ERROR "})
  137.    ELSE
  138.       BrowsePacked( aPacked, nNoOfRows, cCommandLine )
  139.    ENDIF
  140.    setcursor(oldcur)
  141.    setcolor(oldcolor)
  142.    FOR xNum = 0 TO MR
  143.        RESTSCREEN(0,0,xNum,MC,oldscrn)
  144.        inkey(.1)
  145.    NEXT
  146. return nil
  147.  
  148. FUNCTION PackInfo( cCommandLine, aPacked, aInfo )
  149.     LOCAL cFileInfo, cFName, nFileCount := 0, nHandle := FOPEN(cCommandLine)
  150.     LOCAL oldcolor := setcolor()
  151.     
  152.     WHILE .T.
  153.         cFileInfo := SPACE( aInfo[ INFO_SIZE ] )
  154.         FREAD( nHandle, @cFileInfo, aInfo[ INFO_SIZE ] )    
  155.  
  156.         IF ! EVAL( aInfo[ CB_FINISHED ], cFileInfo )
  157.             EXIT
  158.         ENDIF
  159.         nFileCount ++
  160.         // Adds an undefined second dimension on to the array.
  161.         AADD( aPacked, {} )
  162.  
  163.         // Evals the code block that reads the packed files  file name.
  164.         cFName := EVAL( aInfo[ CB_FILE_NAME ], cFileInfo, nHandle )
  165.  
  166.         // Get rid of "/" is directory name is stored in zipfile
  167.         AADD(aPacked[ nFileCount ], SUBS( cFName, RAT( '/', cFName ) + 1 ) )
  168.  
  169.         AADD( aPacked[ nFileCount ], cFName ) 
  170.  
  171.         // Calc the Date of the file
  172.         AADD( aPacked[ nFileCount ],                                        ;
  173.             CalcDate( ASC( SUBSTR( cFileInfo,                               ;
  174.             aInfo[ POS_YEAR_MON ], 1 ) ),                                   ;
  175.             ASC( SUBSTR( cFileInfo, aInfo[ POS_MON_DAY ],   1 ) ) ) )
  176.  
  177.         // Calc the Time of the file
  178.         AADD( aPacked[ nFileCount ],                                        ;
  179.             CalcTime( ASC( SUBSTR( cFileInfo,                               ;
  180.             aInfo[ POS_MINUTES ], 1 ) ),                                    ;
  181.             ASC( SUBSTR( cFileInfo, aInfo[ POS_MIN_HOUR ],  1 ) ) ) )
  182.  
  183.         // Calc the size of the file before compression
  184.         AADD( aPacked[ nFileCount ],                                        ;
  185.             BIN2L( SUBSTR( cFileInfo, aInfo[ POS_ORIGINAL ],4 ) ) )
  186.  
  187.         // Calc the size of the file after compression
  188.         AADD( aPacked[ nFileCount ],                                        ;
  189.             BIN2L( SUBSTR( cFileInfo, aInfo[ POS_PACKED ],  4 ) ) )
  190.  
  191.         // Calc the ratio of the file compression to the fullSize of the file
  192.         AADD( aPacked[ nFileCount ],;
  193.             Ratio( aPacked[ nFileCount, F_ORIGINAL ],                       ;
  194.             aPacked[ nFileCount, F_PACKED ] ) )
  195.  
  196.         // Fills the element with the type of the compression
  197.         AADD( aPacked[ nFileCount ], EVAL( aInfo[ CB_FILE_TYPE ],           ;
  198.             cFileInfo ) )
  199.  
  200.         // Inserts the position of the file in the pack file
  201.         AADD( aPacked[ nFileCount ], nFileCount )
  202.  
  203.         // Moves the file pointer to the next section
  204.         FSEEK( nHandle, aPacked[ nFileCount, F_PACKED ], FS_RELATIVE )
  205.  
  206.     ENDDO
  207.  
  208.     /*
  209.     * Returns the number of files found in order to pass the value to
  210.     * the tbrowse function.  This is for control of the boundrys of array.
  211.     */
  212. RETURN nFileCount
  213.  
  214. FUNCTION BrowsePacked( aPacked, nLenArray, cCommandLine )
  215.     LOCAL cDefCol, cDefColor, cHilite, cNoOfFiles, jj, nArrPos := 1, nKey, c
  216.     LOCAL oHeadColor, cMsg:="", TBar_:={},nTr:=2, nTc:=3, nBr:=19, nBc:=74
  217.     LOCAL nLeftCol, nRightCol, nSortPick, b:= TBROWSENEW( 2, 3, 19, 74 )
  218.  
  219.     ZoomBox(1,2,21,75,"W+/B" , 5, .T. )
  220.     //
  221.     // attach scrollbar to browse
  222.     //
  223.     TBar_  := ScrollBarDisplay( { nTr+1, nBc+1, nBr, nBc+1, "w+/b", 1 } )
  224.     //
  225.     cWhichFile := UPPER( RTRIM( cCommandLine ) )
  226.     cDefColor  := SETCOLOR( "gr+/b" )
  227.     @20, 5 SAY UPPER( cCommandLine )
  228.     cNoOfFiles := LTRIM( STR( nLenArray ) ) + " Files"
  229.     @20, ( 73 - LEN( cNoOfFiles ) ) SAY cNoOfFiles
  230.  
  231.     b:HEADSEP := "¬ƒ"
  232.     b:COLSEP  := "≥"
  233.     b:FOOTSEP := "¡ƒ"
  234.     b:COLORSPEC:="w+/b,w+/n,w+/b,w+/br,n/bg,n/w,n/g,w/b,w+/b,rb+/b"
  235.     #ifdef COMMANDER
  236.        b:SKIPBLOCK:={ | nMove | ArraySkip( nLenArray, @nArrPos, nMove ) }
  237.     #else
  238.        b:SKIPBLOCK:={ | nMove | SkipArray( nMove, @nArrPos, nLenArray ) }
  239.     #endif
  240.  
  241.     c:= TBColumnNew( "  FILE NAME",                                         ;
  242.         { || PADR( IF( Len( aPacked[ nArrPos, F_NAME_LONG ] ) <>            ;
  243.         Len( aPacked[ nArrPos, F_NAME ] ), CHR( 7 ), " " ) +                ;
  244.         aPacked[ nArrPos, F_NAME ], 14 ) }                                  ;
  245.     )
  246.     c:colorBlock:={ || {1,1} }
  247.     c:WIDTH := 14
  248.     b:ADDCOLUMN( c )
  249.     
  250.     c:=TBColumnNew("   DATE",{ || PADC(aPacked[ nArrPos,F_DATE ],10) })
  251.     c:colorBlock:={|| {1,1} }
  252.     c:WIDTH := 10
  253.     b:ADDCOLUMN( c )
  254.  
  255.     c:= TBColumnNew(" TIME",{ || PADC( aPacked[ nArrPos,F_TIME ], 7 )})
  256.     c:colorBlock:={ || {1,1} }
  257.     c:WIDTH := 7
  258.     b:ADDCOLUMN( c )
  259.  
  260.     c:=TBColumnNew(" ORIGINAL",{|| STR(aPacked[nArrPos,F_ORIGINAL],9,0)+ " "})
  261.     c:colorBlock:={ || {1,1} }
  262.     c:WIDTH := 10
  263.     b:ADDCOLUMN( c )
  264.  
  265.     c:=TBColumnNew("  PACKED",{|| STR(aPacked[nArrPos,F_PACKED],9,0)+" " } )
  266.     c:colorBlock:={ || {1,1} }
  267.     c:WIDTH := 10
  268.     b:ADDCOLUMN( c )
  269.  
  270.     c:=TBColumnNew("RATIO",{ || aPacked[ nArrPos, F_RATIO ] } )
  271.     c:colorBlock:={ || {1,1} }
  272.     c:WIDTH := 5
  273.     b:ADDCOLUMN( c )
  274.  
  275.     c:=TBColumnNew("  TYPE",{ || aPacked[ nArrPos, F_COMPRESS ] } )
  276.     c:colorBlock:={ || {1,1} }
  277.     c:WIDTH := 10
  278.     b:ADDCOLUMN( c )
  279.  
  280.     for jj:=1 to b:colCount
  281.        b:getcolumn(jj):defcolor:={10,10}
  282.     next
  283.  
  284.     // Returns the right and left boundaries of the browse
  285.     nLeftCol := b:nLEFT
  286.     nRightCol:= b:nRIGHT
  287.  
  288.     nKey := 0
  289.  
  290.     WHILE .T.
  291.         b:colorRect( { b:rowPos, 1, b:rowPos, b:colCount}, {9,9}, {1,1} )
  292.         STABILIZE b
  293.         if b:stabilize()
  294.            b:colorRect( { b:rowPos,1,b:rowPos,b:colCount}, {9,9}, {2,2} )
  295.            TMARKER( b:rowPos+3, 3, b:rowPos+3, maxcol()-5, 14 )
  296.            ScrollBarUpdate(TBar_,nArrPos,nLenArray,TRUE)
  297.            WHILE ((nKey := WKEY(.1)) == 0)
  298.                    TICK_TAPE()
  299.            END
  300.         endif
  301.         DO CASE
  302.             CASE nKey EQ K_DOWN
  303.                 b:DOWN()
  304.             CASE nKey EQ K_UP
  305.                 b:UP()
  306.             CASE nKey EQ K_PGDN
  307.                 b:PAGEDOWN()
  308.             CASE nKey EQ K_PGUP
  309.                 b:PAGEUP()
  310.             CASE nKey EQ K_ENTER
  311.                 IF !EMPTY( IsInPath( "LIST.COM") )
  312.                     ViewIt(aPacked[ nArrPos, F_NAME_LONG ],cWhichFile)
  313.                 ENDIF
  314.             CASE nKey EQ K_SPACEBAR
  315.                 IF !EMPTY( IsInPath( "PKUNZIP.EXE" ) )
  316.                     IF !EMPTY( IsInPath( "LIST.COM" ) )
  317.                         Decomp(aPacked[ nArrPos, F_NAME_LONG ],cWhichFile)
  318.                     ENDIF
  319.                 ENDIF
  320.             CASE nKey EQ K_F10
  321.                 setcolor(cDefColor) 
  322.                 EXIT
  323.             CASE nKey EQ K_F1 .OR. nKey EQ K_ESC
  324.                 #ifdef USE_HELP
  325.                    DO_HELP()
  326.                 #endif
  327.         ENDCASE
  328.      ENDDO
  329. return nil
  330.  
  331. #ifdef USE_HELP
  332. FUNCTION DO_HELP
  333.     local SaveFullScreen(), oldcolor:=setcolor("W+/R"), nKey:=0
  334.     ZoomBox(1,2,19,73,"W+/R",14,.T.)
  335.     @ 2,4 say "             ENTER -"
  336.     @ 3,4 say "          SPACEBAR -"
  337.     @ 4,4 say "               F10 -"
  338.     @ 6,4 say " ABOUT THIS PROGRAM"
  339.     @ 7,4 say "ORIGINAL PROGRAMMER:"
  340.     @ 8,4 say "   MODIFICATIONS BY:" 
  341.     @ 9,4 say "LANGAUAGE/LIBRARIES:" 
  342.  
  343.     setcolor("gr+/r")
  344.     @ 2,25 say "View highlighted file"
  345.     @ 3,25 say "Extract highlighted file"
  346.     @ 4,25 say "Exit this program"
  347.     @ 7,25 say "Micheal Todd Charron"
  348.     @ 8,25 say "Kevin Sean Gallagher"
  349.     @ 9,25 say "Clipper 5.01 Nanfor.lib"
  350.  
  351.     setcolor("w+/r")
  352.     @11,4 say "Any modifications must retain the above names as well as a list of"
  353.     @12,4 say "changes made to the source code."
  354.  
  355.     @13,4 say "When [spacebar] is pressed to extracted a file, pkunzip.exe is"
  356.     @14,4 say "called to do the decompression, and pkunzip must be in the PATH to"
  357.     @15,4 say "work."
  358.  
  359.     @16,4 say "When [enter] is pressed to view the current highlighted file"
  360.     @17,4 say "an external utility LIST.COM is called to do the viewing, and must"
  361.     @18,4 say "be within the DOS PATH for this program to find it."
  362.  
  363.     @MR,0 say PADC("PRESS ANY KEY TO EXIT HELP",80) color "W+/B"
  364.     nKey:=INKEY(30)
  365.     setcolor(oldcolor)
  366.     RestFullScreen()
  367. return nil          
  368. #endif
  369.  
  370. /*
  371. * Do not fully rely on this function since it mixes PKzip's 
  372. * Warning and errorlevels together. The Blinker Swap errorchecking
  373. * routine can not tell one from the other!
  374. */
  375. function ZipTest( nParm )
  376.     local nErr :=0, cErr,aArray_:={                                        ;
  377.     "00 NO ERRORS",                                                        ;
  378.     "01 FATAL ERROR;FILE HAS BAD TABLE",                                   ;
  379.     "02 FATAL ERROR;FILE HAS BAD TABLE",                                   ;
  380.     "03 FATAL ERROR;FILE HAS BAD TABLE",                                   ;
  381.     "04 INSUFFICIENT MEMORY" ,                                             ;
  382.     "11 DO NOT KNOW HOW TO HANDLE THIS FILE; PKUNZIP ERROR #11" ,          ;
  383.     "12 SKIPPED ENCRYPTED FILE PKUNZIP ERROR #12",                         ;
  384.     "13 FILE DOES NOT EXIST;OR;POSSIBLE DOS I/O ERROR" ,                   ;
  385.     "14 INSUFFICIENT DISKSPACE;OR;DISK FULL." ,                            ;
  386.     "15 FAILED CRC CHECK" ,                                                ;
  387.     "17 ATTEMPT TO COMPRESS TO MANY FILES;OR;CORRUPT FILE HEADER" ,        ;
  388.     "24 FATAL EMS ERROR" ,                                                 ;
  389.     "25 FATAL EMS ERROR" ,                                                 ;
  390.     "26 ONE OR MORE ERRORS DETECTED;CAN NOT CONTINUE" ,                    ;
  391.     "50 DISK FULL;DELETE SOME FILES AND RETRY"                             }
  392.  
  393.     nErr := ASCAN(aArray_,sBlock)
  394.     /*
  395.     *  Any number returned greater than 1 indicates a known error!
  396.     *  If "1" is returned then we have success
  397.     *  If "0" is returned the error was not located in the error array
  398.     */
  399.     DO CASE
  400.         CASE nErr EQ 1    ;   cErr:=""
  401.         CASE nErr EQ 0    ;   cErr:= "UNKNOW ERROR OCCURED"
  402.         OTHERWISE         ;   cErr:= SUBS(aArray_[nErr],4)
  403.     ENDCASE
  404. return cErr
  405.  
  406. STATIC FUNCTION TICK_TAPE()
  407.     LOCAL TBM  := " Press F10 to exit - Press F1 for help "
  408.     LOCAL Xl1  := LEN(TBM)
  409.     LOCAL Xl2  := Xl1 - 1
  410.     STATIC w   := 0, nCnt:= 0
  411.  
  412.     SetPos(1,((80-Xl1)/2));DispOut( TBM, "GR+/B")
  413.     SetPos(1,((80-Xl1)/2)+nCnt);DispOut(SUBS(TBM,nCnt+1,1),TBc[++w%12+1]+'/B')
  414.  
  415.     w   :=IF( w > 11, 0, w)
  416.     nCnt:=IF(++nCnt > Xl2,0,nCnt)
  417.  
  418. return nil
  419.  
  420.  
  421.